Thema Datum  Von Nutzer Rating
Antwort
14.07.2022 12:22:16 Lukas
NotSolved
Blau Zellen, falls Textlänge > 1325, mit Text der darunterliegenden Zelle ergänzen
 14.07.2022 16:13:20 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
ralf_b		 Datum:
14.07.2022 16:13:20		 Views:
495		 Rating:
     
Antwort:
  Ja
Thema:
Zellen, falls Textlänge > 1325, mit Text der darunterliegenden Zelle ergänzen
versuchs mal damit. Das Makro muß aufgerufen werden wenn das Arbeitblatt mit den zu kopierenden Zeilen aktiv ist. Es wird davon ausgegangen das in dieser Tabelle keine Spaltenüberschriften existieren. wenn doch, dann i = 1 in in = Nr der ersten Datenzeile ändern. In der neuen Tabelle, wird auch ab der ersten Zeile eingefügt. 
Sub Zelleverketten()
 
 Dim chSuchSpalte As String, chVerkettSpalte As String
 Dim sh1 As Worksheet, sh2 As Worksheet
 Dim i As Long, cnt As Long, loletzte As Long, linputRow As Long
 Dim rng As Range
 Dim sText As String
 
 chSuchSpalte = "A"
 chVerkettSpalte = "B"
 linputRow = 1
 i = 1
 loletzte = Cells(Rows.Count, chSuchSpalte).End(xlUp).Row
 
 With ThisWorkbook
  Set sh1 = ActiveSheet
  Set sh2 = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
  sh2.Name = "neues Blatt " & Format(Time, "hhmmss")
  sh1.Activate
 End With
 
 For i = 1 To loletzte
    
    If Cells(i, chSuchSpalte) <> "" Then
      
      cnt = Cells(i, chSuchSpalte).End(xlDown).Row
      Set rng = Cells(i, chVerkettSpalte).Resize(cnt - i)
      sText = WorksheetFunction.Concat(rng)
      Rows(i).Copy sh2.Rows(linputRow).Cells(1)
      sh2.Cells(linputRow, chVerkettSpalte).Value = sText
      
      linputRow = linputRow + 1
      i = cnt
      
    End If
  Next
  
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
14.07.2022 12:22:16 Lukas
NotSolved
Blau Zellen, falls Textlänge > 1325, mit Text der darunterliegenden Zelle ergänzen
 14.07.2022 16:13:20 ralf_b
NotSolved